PC World Interactive 7/PC World Interactive 7.iso/program/vbkontrol.exe/VBDLL15D.ZIP/SERVER.FR_/SERVER.FR

Visual Basic Form | 1995-03-08 | 7.9 KB | 208 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Server"
   ClientHeight    =   4680
   ClientLeft      =   1224
   ClientTop       =   1536
   ClientWidth     =   5268
   Height          =   5208
   Left            =   1188
   LinkTopic       =   "Form1"
   ScaleHeight     =   4680
   ScaleWidth      =   5268
   Top             =   1044
   Visible         =   0   'False
   Width           =   5340
   Begin Timer Timer1
      Enabled         =   0   'False
      Interval        =   10
      Left            =   4404
      Top             =   264
   End
   Begin FUNCTION VBFunctionCtl
      Declaration     =   "DecToHex(b10&) As Variant|InStrRev(HayStk$, Needle$) As Integer|strrev(stparm$)|TypeTestStk(fnd%, lng&,sng!, rl#, st$, fnd2 as integer, lng2 as long, sng2 as single, rl2 as double, st2 as string, StToDate As Variant, DateToSt As Variant) as string|UnloadVbLib(AutoStarted%)|HexToDec (hx$) As Variant||"
      Left            =   3444
      Top             =   264
   End
   Begin FUNCTION VBFunctionCallCtl
      Declaration     =   "ShowForm()|TypeTest$ (fnd%, lng&, sng!, rl#, st$, fnd2 As Integer, lng2 As Long, sng2 As Single, rl2 As Double, st2 As String, stlen As String * 10, StToDate As Variant, DateToSt As Variant)||"
      Left            =   456
      Top             =   216
   End
   Begin ListBox List1
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   6.6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   3456
      Left            =   72
      TabIndex        =   0
      Top             =   852
      Width           =   5172
   End
   Begin Menu mnuCallProc1
      Caption         =   "&Clear"
   End
   Begin Menu mnuTest
      Caption         =   "&Test"
   End
Sub Form_Load ()
    'if running under vb, display
    Dim te As TASKENTRY
    te.dwSize = Len(te)
    bok% = TaskFindHandle(te, GetCurrentTask())
    If bok% = False Then Exit Sub
    If Left$(te.szModule, 3) = "VB" + Chr$(0) Then Me.Show
End Sub
Sub Form_Unload (Cancel As Integer)
        If RecFormLoaded = True Then
            Unload Form2
        End If
    End
End Sub
Sub mnuCallProc1_Click ()
    List1.Clear
End Sub
Sub mnuTest_Click ()
    rv = HexToDec("f001")
End Sub
Sub ShowForm ()
    Form2.Show
End Sub
Sub Timer1_Timer ()
    timer1.Enabled = True
    Unload Me
    End
End Sub
Function TypeTestStk$ (fnd%, lng&, sng!, rl#, st$, fnd2 As Integer, lng2 As Long, sng2 As Single, rl2 As Double, st2 As String, StToDate, DateToSt)

        List1.AddItem Str$(fnd%)
        List1.AddItem Str$(lng&)
        List1.AddItem Str$(sng!)
        List1.AddItem Str$(rl#)
        List1.AddItem st$
        List1.AddItem Str$(fnd2)
        List1.AddItem Str$(lng2)
        List1.AddItem Str$(sng2)
        List1.AddItem Str$(rl2)
        List1.AddItem st2
        List1.AddItem StToDate
        List1.AddItem Format$(DateToSt, "General Date")
        fnd% = 9000
        lng& = 800
        sng! = 70.7
        rl# = 60.06
        st$ = "1string_string1"
        fnd2 = 1
        lng2 = 20
        sng2 = 30.3
        rl2 = 40.04
        st2 = "string2_2string"
        TypeTestStk$ = "stringret"
        StToDate = Date
        DateToSt = "January 16, 1995"
End Function
Sub VBFunctionCallCtl_CallProc (ParmPnt As Long, FunctionName As String)
'CallProc Event Code for TypeTest using fixed parm functions.
Select Case FunctionName
    Case "TypeTest"
        Dim TypeTestReturnVal As String
        Dim Parm As TypeTestType
        ErrCode% = CopyParmsToVB(Parm, ParmPnt)
        TypeTestReturnVal = TypeTest(Parm.fnd, Parm.lng, Parm.sng, Parm.rl, Parm.st, Parm.fnd2, Parm.lng2, Parm.sng2, Parm.rl2, Parm.st2, Parm.stlen, Parm.StToDate, Parm.DateToSt)
        ErrCode% = CopyParmsFromVB(Parm, ParmPnt, TypeTestReturnVal)
    Case "ShowForm"
        Call ShowForm
End Select
End Sub
Sub VBFunctionCtl_CallProc (ParmPnt As Long, FunctionName As String)
Select Case FunctionName
    Case "DecToHex"
        Dim DecToHexReturnVal As Variant
        ErrCode% = VCopyToDecToHex(b10&, ParmPnt)
        DecToHexReturnVal = DecToHex(b10&)
        ErrCode% = VCopyFromDecToHex(b10&, ParmPnt, DecToHexReturnVal)
    Case "HexToDec"
        Dim HexToDecReturnVal As Variant
        ErrCode% = VCopyToHexToDec(hx$, ParmPnt)
        HexToDecReturnVal = HexToDec(hx$)
        ErrCode% = VCopyFromHexToDec(hx$, ParmPnt, HexToDecReturnVal)
    Case "InStrRev"
        Dim InStrRevReturnVal As Integer
        ErrCode% = VCopyToInStrRev(HayStk$, Needle$, ParmPnt)
        InStrRevReturnVal = InStrRev(HayStk$, Needle$)
        ErrCode% = VCopyFromInStrRev(HayStk$, Needle$, ParmPnt, InStrRevReturnVal)
    Case "strrev"
        ErrCode% = VCopyTostrrev(stparm$, ParmPnt)
        Call strrev(stparm$)
        ErrCode% = VCopyFromstrrev(stparm$, ParmPnt, 0)
    Case "TypeTestStk"
        Dim TypeTestStkReturnVal As String
        Dim fnd2 As Integer
        Dim lng2 As Long
        Dim sng2 As Single
        Dim rl2 As Double
        Dim st2 As String
        Dim StToDate As Variant
        Dim DateToSt As Variant
        ErrCode% = VCopyToTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt)
        TypeTestStkReturnVal = TypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt)
        ErrCode% = VCopyFromTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt, TypeTestStkReturnVal)
    Case "UnloadVbLib"
        ErrCode% = CopyParmsToVB(AutoStarted%, ParmPnt)
        'If AutoStarted% = True Then
            timer1.Enabled = True
        'End If
End Select
'If FunctionName = "UnloadVbLib" Then
'    ErrCode% = CopyParmsToVB(AutoStarted%, ParmPnt)
'    'If AutoStarted% = True Then
'        timer1.Enabled = True
'    'End If
'    Exit Sub
'End If
''CallProc Event Code for HexToDec using variable parm functions.
'If FunctionName = "HexToDec" Then
'    Dim HexToDecReturnVal As Variant
'    ErrCode% = VCopyToHexToDec(hx$, ParmPnt)
'    HexToDecReturnVal = HexToDec(hx$)
'    ErrCode% = VCopyFromHexToDec(hx$, ParmPnt, HexToDecReturnVal)
'End If
''CallProc Event Code for DecToHex using variable parm functions.
'If FunctionName = "DecToHex" Then
'    Dim DecToHexReturnVal As Variant
'    ErrCode% = VCopyToDecToHex(b10&, ParmPnt)
'    DecToHexReturnVal = DecToHex(b10&)
'    ErrCode% = VCopyFromDecToHex(b10&, ParmPnt, DecToHexReturnVal)
'End If
''CallProc Event Code for TypeTestStk using variable parm functions.
'If FunctionName = "TypeTestStk" Then
'    Dim TypeTestStkReturnVal As String
'    Dim fnd2 As Integer
'    Dim lng2 As Long
'    Dim sng2 As Single
'    Dim rl2 As Double
'    Dim st2 As String
'    Dim StToDate As Variant
'    Dim DateToSt As Variant
'    ErrCode% = VCopyToTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt)
'    TypeTestStkReturnVal = TypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt)
'    ErrCode% = VCopyFromTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt, TypeTestStkReturnVal)
'End If
''CallProc Event Code for strrev using variable parm functions.
'If FunctionName = "strrev" Then
'    ErrCode% = VCopyTostrrev(stparm$, ParmPnt)
'    Call strrev(stparm$)
'    ErrCode% = VCopyFromstrrev(stparm$, ParmPnt, 0)
'End If
''CallProc Event Code for InStrRev using variable parm functions.
'If FunctionName = "InStrRev" Then
'    Dim InStrRevReturnVal As Integer
'    ErrCode% = VCopyToInStrRev(HayStk$, Needle$, ParmPnt)
'    InStrRevReturnVal = InStrRev(HayStk$, Needle$)
'    ErrCode% = VCopyFromInStrRev(HayStk$, Needle$, ParmPnt, InStrRevReturnVal)
'End If
End Sub